VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsSingleMinHeap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

#Const UseContentInverse = False
#Const UseEmptyLinkedList = False

#If UseEmptyLinkedList Then
Private nHead As Long
#End If

Private nCount As Long
Private nMax As Long
Private nContent() As Long
#If UseContentInverse Then
Private nContentInverse() As Long
#End If
Private nValue() As Single

Friend Property Get Max() As Long
Max = nMax
End Property

Friend Property Get Count() As Long
Count = nCount
End Property

Friend Sub Create(ByVal m As Long)
If m > 0 Then
 ReDim nContent(1 To m)
 #If UseContentInverse Then
 ReDim nContentInverse(1 To m)
 #End If
 ReDim nValue(1 To m)
 nMax = m
 nCount = 0
 #If UseContentInverse Then
 #If UseEmptyLinkedList Then
 For m = 1 To nMax - 1
  nContentInverse(m) = -m - 1
 Next m
 nContentInverse(nMax) = 0
 nHead = 1
 #End If
 #End If
End If
End Sub

Friend Sub Destroy()
Erase nContent
#If UseContentInverse Then
Erase nContentInverse
#End If
Erase nValue
nMax = 0
nCount = 0
End Sub

Friend Function Add(ByVal nContentIndex As Long, ByVal Value As Single) As Boolean
Dim nCur As Long, nParent As Long
Dim i As Long
If nCount >= nMax Then Exit Function
#If UseContentInverse Then
#If UseEmptyLinkedList Then
Debug.Assert nContentIndex = nHead
nHead = -nContentInverse(nContentIndex)
#End If
#End If
nCount = nCount + 1
nCur = nCount
Do While nCur > 1
 nParent = nCur \ 2&
 If Value < nValue(nParent) Then
  i = nContent(nParent)
  nContent(nCur) = i
  nValue(nCur) = nValue(nParent)
  #If UseContentInverse Then
  nContentInverse(i) = nCur
  #End If
 Else
  Exit Do
 End If
 nCur = nParent
Loop
nContent(nCur) = nContentIndex
nValue(nCur) = Value
#If UseContentInverse Then
nContentInverse(nContentIndex) = nCur
#End If
Add = True
End Function

Friend Function Remove(ByRef nContentIndex As Long, Optional ByRef Value As Single) As Boolean
Dim nCur As Long, nParent As Long, nSibling As Long
Dim i As Long, v As Single
If nCount <= 0 Then Exit Function
nContentIndex = nContent(1)
Value = nValue(1)
#If UseContentInverse Then
#If UseEmptyLinkedList Then
nContentInverse(nContentIndex) = -nHead
nHead = nContentIndex
#Else
nContentInverse(nContentIndex) = 0
#End If
#End If
nParent = 1
v = nValue(nCount)
Do
 nCur = nParent + nParent
 If nCur >= nCount Then Exit Do
 nSibling = nCur + 1
 If nSibling >= nCount Then
  If nValue(nCur) < v Then
   i = nContent(nCur)
   nContent(nParent) = i
   nValue(nParent) = nValue(nCur)
   #If UseContentInverse Then
   nContentInverse(i) = nParent
   #End If
   nParent = nCur
  End If
  Exit Do
 ElseIf nValue(nCur) < nValue(nSibling) Then
  If nValue(nCur) < v Then
   i = nContent(nCur)
   nContent(nParent) = i
   nValue(nParent) = nValue(nCur)
   #If UseContentInverse Then
   nContentInverse(i) = nParent
   #End If
   nParent = nCur
  Else
   Exit Do
  End If
 Else
  If nValue(nSibling) < v Then
   i = nContent(nSibling)
   nContent(nParent) = i
   nValue(nParent) = nValue(nSibling)
   #If UseContentInverse Then
   nContentInverse(i) = nParent
   #End If
   nParent = nSibling
  Else
   Exit Do
  End If
 End If
Loop
i = nContent(nCount)
nContent(nParent) = i
nValue(nParent) = v
#If UseContentInverse Then
nContentInverse(i) = nParent
#End If
nCount = nCount - 1
Remove = True
End Function

Friend Function GetContentIndex(ByVal nHeapIndex As Long) As Long
GetContentIndex = nContent(nHeapIndex)
End Function

Friend Function GetHeapIndex(ByVal nContentIndex As Long) As Long
#If UseContentInverse Then
GetHeapIndex = nContentInverse(nContentIndex)
#Else
Err.Raise 438
#End If
End Function

Friend Function GetEmptyContentIndex() As Long
Dim i As Long
#If UseContentInverse Then
#If UseEmptyLinkedList Then
GetEmptyContentIndex = nHead
#Else
For i = 1 To nMax
 If nContentInverse(i) <= 0 Then
  GetEmptyContentIndex = i
  Exit Function
 End If
Next i
#End If
#Else
Err.Raise 438
#End If
End Function

Friend Function GetValue(ByVal nHeapIndex As Long) As Single
GetValue = nValue(nHeapIndex)
End Function

Friend Sub SetValue(ByVal nHeapIndex As Long, ByVal Value As Single)
'TODO:
End Sub

Private Sub Class_Terminate()
Destroy
End Sub
